home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbtime.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  15.5 KB  |  515 lines
  1. (*===========================================================================*)
  2. (* Timer service routines                                                    *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. (*===========================================================================*)
  9. (* There are two timers:                                                     *)
  10. (*   1.  Todays/date time.                                                   *)
  11. (*      Format is in ticks since Jan 1, 1980.  One tick = 2 seconds          *)
  12. (*   2.  Uptime                                                              *)
  13. (*      Format is in ticks since MIDNIGHT the day the BBS was started        *)
  14. (*      One tick = .01 seconds                                                *)
  15. (*===========================================================================*)
  16.  
  17. UNIT BBTIME;
  18.  
  19. INTERFACE
  20.  
  21.   USES
  22.     DOS;
  23.  
  24.   PROCEDURE time_check;
  25.   PROCEDURE new_date;
  26.   FUNCTION  time_str      (in_time : LONGINT; year_sw : BOOLEAN) : STRING;
  27.   FUNCTION  time_next_hour(min_hour: WORD) : LONGINT;
  28.   PROCEDURE unconvert_time(in_t    : LONGINT;  VAR out_s : DATETIME);
  29.   PROCEDURE convert_time  (in_s    : DATETIME; VAR out_t : LONGINT);
  30.   FUNCTION  time_from_now (secs    : WORD) : LONGINT;
  31.   FUNCTION  up_time_from_now (secs : WORD) : LONGINT;
  32.   FUNCTION  time_unstr    (in_time : STRING; VAR err : BOOLEAN) : LONGINT;
  33.   PROCEDURE get_up_time;
  34.   PROCEDURE calc_up_time;
  35.  
  36. (*===========================================================================*)
  37. (* Global constants for all timers                                           *)
  38. (*===========================================================================*)
  39.  
  40. {$I BBTIMEC.PAS}
  41.  
  42. (*===========================================================================*)
  43. (* Global variables                                                          *)
  44. (*===========================================================================*)
  45.  
  46. VAR
  47.   last_min             : WORD;
  48.   last_hours           : WORD;
  49.  
  50. IMPLEMENTATION
  51.  
  52. USES
  53.   bbdummy,
  54.   bbstr;
  55.  
  56. (*===========================================================================*)
  57. (* Global variables but local to unit                                        *)
  58. (*===========================================================================*)
  59.  
  60. VAR
  61.  
  62.   work_str          : STRING[4];
  63.  
  64. (*===========================================================================*)
  65. (* Forwards                                                                  *)
  66. (*===========================================================================*)
  67.  
  68. PROCEDURE new_time; FORWARD;
  69.  
  70. (*===========================================================================*)
  71. (* Convert time from LONGINT to Turbo's structure                            *)
  72. (*===========================================================================*)
  73.  
  74. PROCEDURE unconvert_time(in_t : LONGINT; VAR out_s : DATETIME);
  75.  
  76.   VAR
  77.     i    : BYTE;
  78.     j    : BYTE;
  79.     leap : BYTE;
  80.     w    : WORD;
  81.  
  82.   BEGIN;
  83.     WITH out_s DO
  84.       BEGIN;
  85.  
  86.         IF in_t < 0 THEN in_t := 0;
  87.  
  88.         sec  := (in_t MOD 30) SHL secs_per_tick_shift;
  89.         in_t := in_t DIV 30;
  90.  
  91.         min  := in_t MOD 60;
  92.         in_t := in_t DIV 60;
  93.  
  94.         hour := in_t MOD 24;
  95.         in_t := in_t DIV 24;
  96.  
  97.         leap := in_t DIV days_per_4year;
  98.         w    := in_t MOD days_per_4year;
  99.  
  100.         i    := w DIV 365;
  101.         IF i > 3 THEN
  102.           i := 3;
  103.         year := 1981 + 4 * leap + i;
  104.         w    := w + 1 - i * 365;
  105.         j := 1;
  106.         IF i <> 3 THEN
  107.           BEGIN;
  108.             WHILE (j <= 11) AND (w > y_noleap[j+1]) DO
  109.               INC(j);
  110.             day := w - y_noleap[j];
  111.           END
  112.         ELSE
  113.           BEGIN;
  114.             WHILE (j <= 11) AND (w > y_leap[j+1]) DO
  115.               INC(j);
  116.             day := w - y_leap[j];
  117.           END;
  118.         month := j;
  119.       END;
  120.   END;
  121.  
  122. (*===========================================================================*)
  123. (* Convert time to LONGINT from Turbo's structure                            *)
  124. (*===========================================================================*)
  125.  
  126. PROCEDURE convert_time(in_s : DATETIME; VAR out_t : LONGINT);
  127.   VAR
  128.     i : WORD;
  129.     j : WORD;
  130.     t : LONGINT;
  131.   BEGIN;
  132.  
  133.     i := in_s.sec SHR secs_per_tick_shift + WORD(in_s.hour) * ticks_per_hour
  134.                                               + WORD(in_s.min) * ticks_per_min;
  135.     t := LONGINT(i) + LONGINT(ticks_per_day) * (in_s.day - 1);
  136.  
  137.     i := in_s.year;
  138.     IF i > 1900 THEN
  139.       i := i - 1981
  140.     ELSE
  141.       i := i - 81;
  142.  
  143.     j := i AND 3;
  144.     i := i SHR 2;
  145.  
  146.     IF j <> 3 THEN
  147.       j := 365 * j + y_noleap[in_s.month]
  148.     ELSE
  149.       j := 365 * j + y_leap[in_s.month];
  150.  
  151.     out_t := t + ticks_per_day * (LONGINT(j) + days_per_4year * i);
  152.   END;
  153.  
  154. (*===========================================================================*)
  155. (* Calculate a new date/time string                                          *)
  156. (*===========================================================================*)
  157.  
  158. PROCEDURE new_date;
  159.   BEGIN;
  160.  
  161.     GETDATE(today_time.year, today_time.month, today_time.day, todays_dow);
  162.     convert_time(today_time, current_day_time);
  163.  
  164.     STR(today_time.year:4, work_str);
  165.     todays_date_time := SUBSTR(work_str, 3, 2);
  166.  
  167.     STR(today_time.month:2, work_str);
  168.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  169.     todays_date_time := todays_date_time + work_str;
  170.  
  171.     STR(today_time.day:2, work_str);
  172.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  173.     todays_date_time := todays_date_time + work_str + '/';
  174.  
  175.     new_time;
  176.  
  177.     last_midnight := current_day_time
  178.                                     - (current_day_time MOD ticks_per_day);
  179.  
  180.   END;
  181.  
  182. (*===========================================================================*)
  183. (* Calculate a new time string                                               *)
  184. (*===========================================================================*)
  185.  
  186. PROCEDURE new_time;
  187.   BEGIN;
  188.  
  189.     todays_date_time[0] := CHR(7);
  190.  
  191.     STR(today_time.hour:2, work_str);
  192.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  193.     todays_date_time := todays_date_time + work_str;
  194.  
  195.     STR(today_time.min:2, work_str);
  196.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  197.     todays_date_time := todays_date_time + work_str;
  198.  
  199.   END;
  200.  
  201. (*===========================================================================*)
  202. (* Subroutine that reads the clock and verifies the date time stamp          *)
  203. (*===========================================================================*)
  204.  
  205. PROCEDURE time_check;
  206.  
  207.   BEGIN;
  208.  
  209.     GETTIME(today_time.hour, today_time.min, today_time.sec, sec100);
  210.  
  211.     get_up_time;
  212.  
  213.     convert_time(today_time, current_day_time);
  214.  
  215.     IF today_time.min = last_min THEN
  216.       EXIT;
  217.  
  218.     status_window_change := opt_block.opt_time_status;
  219.  
  220.     last_min := today_time.min;
  221.  
  222.     IF today_time.hour <> last_hours THEN
  223.       BEGIN;
  224.         new_date;
  225.         last_hours := today_time.hour;
  226.       END
  227.     ELSE
  228.       new_time;
  229.  
  230.   END;
  231.  
  232. (*===========================================================================*)
  233. (* Convert a date/time stamp to characters                                   *)
  234. (*===========================================================================*)
  235.  
  236. FUNCTION  time_str(in_time : LONGINT; year_sw : BOOLEAN) : STRING;
  237.  
  238.   VAR
  239.     i      : BYTE;
  240.     t_str  : STRING;
  241.     t_time : DATETIME;
  242.  
  243.   BEGIN;
  244.  
  245.     (*-----------------------------------------------------------------------*)
  246.     (* Break time into pieces.                                               *)
  247.     (*-----------------------------------------------------------------------*)
  248.  
  249.     unconvert_time(in_time, t_time);
  250.  
  251.     (*-----------------------------------------------------------------------*)
  252.     (* If year wanted, add it                                                *)
  253.     (*-----------------------------------------------------------------------*)
  254.  
  255.     IF year_sw THEN
  256.       BEGIN;
  257.         STR(t_time.year:2, work_str);
  258.         t_str[0] := CHR(2);
  259.         IF t_time.year > 99 THEN
  260.           i := 3
  261.         ELSE
  262.           i := 1;
  263.         t_str[1] := work_str[i];
  264.         t_str[2] := work_str[i+1];
  265.       END
  266.     ELSE
  267.       t_str := '';
  268.  
  269.     (*-----------------------------------------------------------------------*)
  270.     (* Convert the rest                                                      *)
  271.     (*-----------------------------------------------------------------------*)
  272.  
  273.     STR(t_time.month:2, work_str);
  274.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  275.     t_str := t_str + work_str;
  276.  
  277.     STR(t_time.day:2, work_str);
  278.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  279.     t_str := t_str + work_str +  '/';
  280.  
  281.     STR(t_time.hour:2, work_str);
  282.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  283.     t_str := t_str + work_str;
  284.  
  285.     STR(t_time.min:2, work_str);
  286.     IF work_str[1] = ' ' THEN work_str[1] := '0';
  287.     time_str := t_str + work_str;
  288.  
  289.   END;
  290.  
  291. (*===========================================================================*)
  292. (* Convert characters to a date time stamp                                   *)
  293. (*===========================================================================*)
  294.  
  295. FUNCTION  time_unstr(in_time : STRING; VAR err : BOOLEAN) : LONGINT;
  296.  
  297.   VAR
  298.     code   : INTEGER;
  299.     i      : BYTE;
  300.     j      : INTEGER;
  301.     nz     : BOOLEAN;
  302.     t_str  : STRING[4];
  303.     t_time : DATETIME;
  304.     w_time : LONGINT;
  305.  
  306.   FUNCTION cvt : WORD;
  307.     BEGIN;
  308.       IF i = LENGTH(in_time) THEN
  309.         BEGIN;
  310.           cvt := 0;
  311.           err := TRUE;
  312.           EXIT;
  313.         END;
  314.  
  315.       IF i > LENGTH(in_time) THEN
  316.         BEGIN;
  317.           cvt := 0;
  318.           EXIT;
  319.         END;
  320.  
  321.       VAL(substr(in_time, i, 2), j, code);
  322.       err := (code <> 0) OR ((j = 0) AND nz);
  323.       cvt := j;
  324.       i   := i + 2;
  325.  
  326.     END;
  327.  
  328.   BEGIN;
  329.  
  330.     strip_var(in_time, 'B');
  331.  
  332.     WITH t_time DO
  333.       BEGIN;
  334.  
  335.         err := TRUE;
  336.         nz  := TRUE;
  337.  
  338.         IF in_time[1] = '1' THEN
  339.           BEGIN;
  340.             IF LENGTH(in_time) < 4 THEN EXIT;
  341.             t_str   := substr(in_time, 1, 4);
  342.             in_time := substr(in_time, 5, 0);
  343.           END
  344.         ELSE
  345.           BEGIN
  346.             IF LENGTH(in_time) < 2 THEN EXIT;
  347.             t_str   := substr(in_time, 1, 2);
  348.             in_time := substr(in_time, 3, 0);
  349.           END;
  350.  
  351.         VAL(t_str, year, code);
  352.         IF code <> 0 THEN EXIT;
  353.  
  354.         i := 1;
  355.  
  356.         month := cvt;
  357.         IF month > 12 THEN
  358.           err := TRUE;
  359.         IF err THEN EXIT;
  360.  
  361.         day := cvt;
  362.         IF day > 31 THEN
  363.           err := TRUE;
  364.         IF err THEN EXIT;
  365.  
  366.         IF in_time[i] = '/' THEN
  367.           INC(i);
  368.  
  369.         nz  := FALSE;
  370.  
  371.         hour := cvt;
  372.         IF hour > 23 THEN
  373.           err := TRUE;
  374.         IF err THEN EXIT;
  375.  
  376.         min  := cvt;
  377.         IF min > 59 THEN
  378.           err := TRUE;
  379.         IF err THEN EXIT;
  380.  
  381.         sec := 0;
  382.  
  383.       END;
  384.  
  385.     convert_time(t_time, w_time);
  386.  
  387.     time_unstr := w_time;
  388.  
  389.   END;
  390.  
  391. (*===========================================================================*)
  392. (* Add a certain number of seconds onto current time                         *)
  393. (*===========================================================================*)
  394.  
  395. FUNCTION  time_from_now (secs : WORD) : LONGINT;
  396.   BEGIN;
  397.  
  398.     IF secs < secs_per_tick THEN
  399.       secs := secs_per_tick;
  400.  
  401.     secs := secs SHR secs_per_tick_shift;
  402.  
  403.     time_from_now := current_day_time + secs;
  404.  
  405.   END;
  406.  
  407. (*===========================================================================*)
  408. (* Given a number of minutes past the hour, find the next time that occurs   *)
  409. (*===========================================================================*)
  410.  
  411. FUNCTION time_next_hour(min_hour: WORD) : LONGINT;
  412.  
  413.   VAR
  414.     t_offset   : WORD;
  415.     t_time     : DATETIME;
  416.     t_time_int : LONGINT;
  417.  
  418.  
  419.   BEGIN;
  420.  
  421.     (*-----------------------------------------------------------------------*)
  422.     (* Put time in work area                                                 *)
  423.     (*-----------------------------------------------------------------------*)
  424.  
  425.     t_time := today_time;
  426.  
  427.     (*-----------------------------------------------------------------------*)
  428.     (* Calculate the time at the last hour mark                              *)
  429.     (*-----------------------------------------------------------------------*)
  430.  
  431.     t_time.min := 0;
  432.     t_time.sec := 0;
  433.  
  434.     convert_time(t_time, t_time_int);
  435.  
  436.     (*-----------------------------------------------------------------------*)
  437.     (* Calculate offset from the hour mark for the time we want              *)
  438.     (*-----------------------------------------------------------------------*)
  439.  
  440.     t_offset := min_hour * ticks_per_min;
  441.  
  442.     (*-----------------------------------------------------------------------*)
  443.     (* Now figure out the time this hour for the time we want                *)
  444.     (*-----------------------------------------------------------------------*)
  445.  
  446.     t_time_int := t_time_int + t_offset;
  447.  
  448.     (*-----------------------------------------------------------------------*)
  449.     (* If that time is already past, add an hour                             *)
  450.     (*-----------------------------------------------------------------------*)
  451.  
  452.     IF t_time_int <= current_day_time THEN
  453.       t_time_int := t_time_int + ticks_per_hour;
  454.  
  455.     (*-----------------------------------------------------------------------*)
  456.     (* Set result                                                            *)
  457.     (*-----------------------------------------------------------------------*)
  458.  
  459.     time_next_hour := t_time_int;
  460.  
  461.   END;
  462.  
  463. (*===========================================================================*)
  464. (* Calculate the up time                                                     *)
  465. (*===========================================================================*)
  466.  
  467. PROCEDURE get_up_time;
  468.  
  469.   VAR
  470.     new_up_time : LONGINT;
  471.  
  472.   BEGIN;
  473.  
  474.     new_up_time := sec100 + LONGINT(today_time.sec) * up_ticks_per_sec
  475.                                + LONGINT(today_time.min) * up_ticks_per_min
  476.                                + LONGINT(today_time.hour) * up_ticks_per_hour
  477.                                + LONGINT(up_days) * up_ticks_per_day;
  478.  
  479.     IF new_up_time < up_time THEN
  480.       BEGIN
  481.         INC(up_days);
  482.         new_up_time := new_up_time + up_ticks_per_day;
  483.       END;
  484.  
  485.     up_time := new_up_time;
  486.  
  487.   END;
  488.  
  489. (*===========================================================================*)
  490. (* Get up time now                                                           *)
  491. (*===========================================================================*)
  492.  
  493. PROCEDURE calc_up_time;
  494.  
  495.   BEGIN;
  496.  
  497.     GETTIME(today_time.hour, today_time.min, today_time.sec, sec100);
  498.  
  499.     get_up_time;
  500.  
  501.   END;
  502.  
  503. (*===========================================================================*)
  504. (* Add a certain number of seconds onto current up time                      *)
  505. (*===========================================================================*)
  506.  
  507. FUNCTION  up_time_from_now (secs : WORD) : LONGINT;
  508.   BEGIN;
  509.  
  510.     up_time_from_now := up_time + secs * LONGINT(up_ticks_per_sec);
  511.  
  512.   END;
  513.  
  514. END.
  515.